
(define-library (srfi 116 test)
  (import (scheme base) (srfi 116) (chibi test))
  (export run-tests)
  (begin
    (define (run-tests)
      (test-group "ilists"

        (test-group "ilists/constructors"
          (define abc (ilist 'a 'b 'c))
          (define abc-dot-d (ipair* 'a 'b 'c 'd))
          (define abc-copy (ilist-copy abc))
          (test 'a (icar abc))
          (test 'b (icadr abc))
          (test 'c (icaddr abc))
          (test (ipair 2 1) (xipair 1 2))
          (test 'd (icdddr abc-dot-d))
          (test (iq c c c c) (make-ilist 4 'c))
          (test (iq 0 1 2 3) (ilist-tabulate 4 values))
          (test (iq 0 1 2 3 4) (iiota 5))
          (test abc abc-copy)
          (test-assert (not (eq? abc abc-copy))))

        (test-group "ilists/predicates"
          (test-assert (ipair? (ipair 1 2)))
          (test-assert (proper-ilist? '()))
          (test-assert (proper-ilist? (iq 1 2 3)))
          (test-assert (ilist? '()))
          (test-assert (ilist? (iq 1 2 3)))
          (test-assert (dotted-ilist? (ipair 1 2)))
          (test-assert (dotted-ilist? 2))
          (test-assert (null-ilist? '()))
          (test-assert (not (null-ilist? (iq 1 2 3))))
          ;;(test-error (null-ilist? 'a))
          (test-assert (not-ipair? 'a))
          (test-assert (not (not-ipair? (ipair 'a 'b))))
          (test-assert (ilist= = (iq 1 2 3) (iq 1 2 3)))
          (test-assert (ilist= = (iq 1 2 3) (iq 1 2 3) (iq 1 2 3)))
          (test-assert (not (ilist= = (iq 1 2 3 4) (iq 1 2 3))))
          (test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3 4))))
          (test-assert (ilist= = (iq 1 2 3) (iq 1 2 3)))
          (test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3 4) (iq 1 2 3 4))))
          (test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3) (iq 1 2 3 4)))))

        (test-group "ilist/cxrs"
          (define ab (ipair 'a 'b))
          (define cd (ipair 'c 'd))
          (define ef (ipair 'e 'f))
          (define gh (ipair 'g 'h))
          (define abcd (ipair ab cd))
          (define efgh (ipair ef gh))
          (define abcdefgh (ipair abcd efgh))
          (define ij (ipair 'i 'j))
          (define kl (ipair 'k 'l))
          (define mn (ipair 'm 'n))
          (define op (ipair 'o 'p))
          (define ijkl (ipair ij kl))
          (define mnop (ipair mn op))
          (define ijklmnop (ipair ijkl mnop))
          (define abcdefghijklmnop (ipair abcdefgh ijklmnop))
          (test 'a (icaar abcd))
          (test 'b (icdar abcd))
          (test 'c (icadr abcd))
          (test 'd (icddr abcd))
          (test 'a (icaaar abcdefgh))
          (test 'b (icdaar abcdefgh))
          (test 'c (icadar abcdefgh))
          (test 'd (icddar abcdefgh))
          (test 'e (icaadr abcdefgh))
          (test 'f (icdadr abcdefgh))
          (test 'g (icaddr abcdefgh))
          (test 'h (icdddr abcdefgh))
          (test 'a (icaaaar abcdefghijklmnop))
          (test 'b (icdaaar abcdefghijklmnop))
          (test 'c (icadaar abcdefghijklmnop))
          (test 'd (icddaar abcdefghijklmnop))
          (test 'e (icaadar abcdefghijklmnop))
          (test 'f (icdadar abcdefghijklmnop))
          (test 'g (icaddar abcdefghijklmnop))
          (test 'h (icdddar abcdefghijklmnop))
          (test 'i (icaaadr abcdefghijklmnop))
          (test 'j (icdaadr abcdefghijklmnop))
          (test 'k (icadadr abcdefghijklmnop))
          (test 'l (icddadr abcdefghijklmnop))
          (test 'm (icaaddr abcdefghijklmnop))
          (test 'n (icdaddr abcdefghijklmnop))
          (test 'o (icadddr abcdefghijklmnop))
          (test 'p (icddddr abcdefghijklmnop)))

        (test-group "ilists/selectors"
          (define ten (ilist 1 2 3 4 5 6 7 8 9 10))
          (define abcde (iq a b c d e))
          (define dotted (ipair 1 (ipair 2 (ipair 3 'd))))
          (test 'c (ilist-ref (iq a b c d) 2))
          (test 1 (ifirst ten))
          (test 2 (isecond ten))
          (test 3 (ithird ten))
          (test 4 (ifourth ten))
          (test 5 (ififth ten))
          (test 6 (isixth ten))
          (test 7 (iseventh ten))
          (test 8 (ieighth ten))
          (test 9 (ininth ten))
          (test 10 (itenth ten))
          (test-error (ilist-ref '() 2))
          (test '(1 2) (call-with-values (lambda () (icar+icdr (ipair 1 2))) list))
          (test (iq a b) (itake abcde 2))
          (test (iq c d e) (idrop abcde 2))
          (test (iq c d e) (ilist-tail abcde 2))
          (test (iq 1 2) (itake dotted 2))
          (test (ipair 3 'd) (idrop dotted 2))
          (test (ipair 3 'd) (ilist-tail dotted 2))
          (test 'd (idrop dotted 3))
          (test 'd (ilist-tail dotted 3))
          (test abcde (iappend (itake abcde 4) (idrop abcde 4)))
          (test (iq d e) (itake-right abcde 2))
          (test (iq a b c) (idrop-right abcde 2))
          (test (ipair 2 (ipair 3 'd)) (itake-right dotted 2))
          (test (iq 1) (idrop-right dotted 2))
          (test 'd (itake-right dotted 0))
          (test (iq 1 2 3) (idrop-right dotted 0))
          (test abcde (call-with-values (lambda () (isplit-at abcde 3)) iappend))
          (test 'c (ilast (iq a b c)))
          (test (iq c) (last-ipair (iq a b c))))

        (test-group "ilists/misc"
          (test 0 (ilength '()))
          (test 3 (ilength (iq 1 2 3)))
          (test (iq x y) (iappend (iq x) (iq y)))
          (test (iq a b c d) (iappend (iq a b) (iq c d)))
          (test (iq a) (iappend '() (iq a)))
          (test (iq x y) (iappend (iq x y)))
          (test '() (iappend))
          (test (iq a b c d) (iconcatenate (iq (a b) (c d))))
          (test (iq c b a) (ireverse (iq a b c)))
          (test (iq (e (f)) d (b c) a) (ireverse (iq a (b c) d (e (f)))))
          (test (ipair 2 (ipair 1 'd)) (iappend-reverse (iq 1 2) 'd))
          (test (iq (one 1 odd) (two 2 even) (three 3 odd))
              (izip (iq one two three) (iq 1 2 3) (iq odd even odd)))
          (test (iq (1) (2) (3)) (izip (iq 1 2 3)))
          (test (iq 1 2 3) (iunzip1 (iq (1) (2) (3))))
          (test (iq (1 2 3) (one two three))
              (call-with-values
                  (lambda () (iunzip2 (iq (1 one) (2 two) (3 three))))
                ilist))
          (test (iq (1 2 3) (one two three) (a b c))
              (call-with-values
                  (lambda () (iunzip3 (iq (1 one a) (2 two b) (3 three c))))
                ilist))
          (test (iq (1 2 3) (one two three) (a b c) (4 5 6))
              (call-with-values
                  (lambda () (iunzip4 (iq (1 one a 4) (2 two b 5) (3 three c 6))))
                ilist))
          (test (iq (1 2 3) (one two three) (a b c) (4 5 6) (#t #f #t))
              (call-with-values
                  (lambda () (iunzip5 (iq (1 one a 4 #t) (2 two b 5 #f) (3 three c 6 #t))))
                ilist))
          (test 3 (icount even? (iq 3 1 4 1 5 9 2 5 6)))
          (test 3 (icount < (iq 1 2 4 8) (iq 2 4 6 8 10 12 14 16))))

        (test-group "ilists/folds"
          ;; We have to be careful to test both single-list and multiple-list
          ;; code paths, as they are different in this implementation.
          (define squares (iq 1 4 9 16 25 36 49 64 81 100))
          (define lis (iq 1 2 3))
          (define (z x y ans) (ipair (ilist x y) ans))
          (define z2 (let ((count 0)) (lambda (ignored) (set! count (+ count 1)) count)))
          (test 6 (ifold + 0 lis))
          (test (iq 3 2 1) (ifold ipair '() lis))
          (test 2 (ifold
                   (lambda (x count) (if (symbol? x) (+ count 1) count))
                   0
                   (iq a 0 b)))
          (test 4 (ifold
                   (lambda (s max-len) (max max-len (string-length s)))
                   0
                   (iq "ab" "abcd" "abc")))
          (test 32 (ifold
                    (lambda (a b ans) (+ (* a b) ans))
                    0
                    (iq 1 2 3)
                    (iq 4 5 6)))
          (test (iq (b d) (a c))
              (ifold z '() (iq a b) (iq c d)))
          (test lis (ifold-right ipair '() lis))
          (test (iq 0 2 4) (ifold-right
                            (lambda (x l) (if (even? x) (ipair x l) l))
                            '()
                            (iq 0 1 2 3 4)))
          (test (iq (a c) (b d))
              (ifold-right z '() (iq a b) (iq c d)))
          (test (iq (c) (b c) (a b c))
              (ipair-fold ipair '() (iq a b c)))
          (test (iq ((b) (d)) ((a b) (c d)))
              (ipair-fold z '() (iq a b) (iq c d)))
          (test (iq (a b c) (b c) (c))
              (ipair-fold-right ipair '() (iq a b c)))
          (test (iq ((a b) (c d)) ((b) (d)))
              (ipair-fold-right z '() (iq a b) (iq c d)))
          (test 5 (ireduce max 0 (iq 1 3 5 4 2 0)))
          (test 1 (ireduce - 0 (iq 1 2)))
          (test -1 (ireduce-right - 0 (iq 1 2)))
          (test squares
              (iunfold (lambda (x) (> x 10))
                       (lambda (x) (* x x))
                       (lambda (x) (+ x 1))
                       1))
          (test squares
              (iunfold-right zero?
                             (lambda (x) (* x x))
                             (lambda (x) (- x 1))
                             10))
          (test (iq 1 2 3) (iunfold null-ilist? icar icdr (iq 1 2 3)))
          (test (iq 3 2 1) (iunfold-right null-ilist? icar icdr (iq 1 2 3)))
          (test (iq 1 2 3 4)
              (iunfold null-ilist? icar icdr (iq 1 2) (lambda (x) (iq 3 4))))
          (test (iq b e h) (imap icadr (iq (a b) (d e) (g h))))
          (test (iq b e h) (imap-in-order icadr (iq (a b) (d e) (g h))))
          (test (iq 5 7 9) (imap + (iq 1 2 3) (iq 4 5 6)))
          (test (iq 5 7 9) (imap-in-order + (iq 1 2 3) (iq 4 5 6)))
          (test (iq 1 2) (imap-in-order z2 (iq a b)))
          (test '#(0 1 4 9 16)
              (let ((v (make-vector 5)))
                (ifor-each (lambda (i)
                             (vector-set! v i (* i i)))
                           (iq 0 1 2 3 4))
                v))
          (test '#(5 7 9 11 13)
              (let ((v (make-vector 5)))
                (ifor-each (lambda (i j)
                             (vector-set! v i (+ i j)))
                           (iq 0 1 2 3 4)
                           (iq 5 6 7 8 9))
                v))
          (test (iq 1 -1 3 -3 8 -8)
              (iappend-map (lambda (x) (ilist x (- x))) (iq 1 3 8)))
          (test (iq 1 4 2 5 3 6)
              (iappend-map ilist (iq 1 2 3) (iq 4 5 6)))
          (test (vector (iq 0 1 2 3 4) (iq 1 2 3 4) (iq 2 3 4) (iq 3 4) (iq 4))
              (let ((v (make-vector 5)))
                (ipair-for-each (lambda (lis) (vector-set! v (icar lis) lis)) (iq 0 1 2 3 4))
                v))
          (test (vector (iq 5 6 7 8 9) (iq 6 7 8 9) (iq 7 8 9) (iq 8 9) (iq 9))
              (let ((v (make-vector 5)))
                (ipair-for-each (lambda (i j) (vector-set! v (icar i) j))
                                (iq 0 1 2 3 4)
                                (iq 5 6 7 8 9))
                v))
          (test (iq 1 9 49)
              (ifilter-map (lambda (x) (and (number? x) (* x x))) (iq a 1 b 3 c 7)))
          (test (iq 5 7 9)
              (ifilter-map
               (lambda (x y) (and (number? x) (number? y) (+ x y)))
               (iq 1 a 2 b 3 4)
               (iq 4 0 5 y 6 z2))))

        (test-group "ilists/filtering"
          (test (iq 0 8 8 -4) (ifilter even? (iq 0 7 8 8 43 -4)))
          (test (list (iq one four five) (iq 2 3 6))
              (call-with-values
                  (lambda () (ipartition symbol? (iq one 2 3 four five 6)))
                list))
          (test (iq 7 43) (iremove even? (iq 0 7 8 8 43 -4))))

        (test-group "ilists/searching"
          (test 2 (ifind even? (iq 1 2 3)))
          (test #t (iany  even? (iq 1 2 3)))
          (test #f (ifind even? (iq 1 7 3)))
          (test #f (iany  even? (iq 1 7 3)))
          ;;(test-error (ifind even? (ipair 1 (ipair 3 'x))))
          ;;(test-error (iany  even? (ipair 1 (ipair 3 'x))))
          (test 4 (ifind even? (iq 3 1 4 1 5 9)))
          (test (iq -8 -5 0 0) (ifind-tail even? (iq 3 1 37 -8 -5 0 0)))
          (test (iq 2 18) (itake-while even? (iq 2 18 3 10 22 9)))
          (test (iq 3 10 22 9) (idrop-while even? (iq 2 18 3 10 22 9)))
          (test (list (iq 2 18) (iq 3 10 22 9))
              (call-with-values
                  (lambda () (ispan even? (iq 2 18 3 10 22 9)))
                list))
          (test (list (iq 3 1) (iq 4 1 5 9))
              (call-with-values
                  (lambda () (ibreak even? (iq 3 1 4 1 5 9)))
                list))
          (test #t (iany integer? (iq a 3 b 2.7)))
          (test #f (iany integer? (iq a 3.1 b 2.7)))
          (test #t (iany < (iq 3 1 4 1 5) (iq 2 7 1 8 2)))
          (test #t (ievery integer? (iq 1 2 3 4 5)))
          (test #f (ievery integer? (iq 1 2 3 4.5 5)))
          (test #t (ievery (lambda (a b) (< a b)) (iq 1 2 3) (iq 4 5 6)))
          (test 2 (ilist-index even? (iq 3 1 4 1 5 9)))
          (test 1 (ilist-index < (iq 3 1 4 1 5 9 2 5 6) (iq 2 7 1 8 2)))
          (test #f (ilist-index = (iq 3 1 4 1 5 9 2 5 6) (iq 2 7 1 8 2)))
          (test (iq a b c) (imemq 'a (iq a b c)))
          (test (iq b c) (imemq 'b (iq a b c)))
          (test #f (imemq 'a (iq b c d)))
          (test #f (imemq (ilist 'a) (iq b (a) c)))
          (test (iq (a) c) (imember (ilist 'a) (iq b (a) c)))
          (test (iq 101 102) (imemv 101 (iq 100 101 102))))

        (test-group "ilists/deletion"
          (test (iq 1 2 4 5) (idelete 3 (iq 1 2 3 4 5)))
          (test (iq 3 4 5) (idelete 5 (iq 3 4 5 6 7) <))
          (test (iq a b c z) (idelete-duplicates (iq a b a c a b c z))))

        (test-group "ilists/alists"
          (define e (iq (a 1) (b 2) (c 3)))
          (define e2 (iq (2 3) (5 7) (11 13)))
          (test (iq a 1) (iassq 'a e))
          (test (iq b 2) (iassq 'b e))
          (test #f (iassq 'd e))
          (test #f (iassq (ilist 'a) (iq ((a)) ((b)) ((c)))))
          (test (iq (a)) (iassoc (ilist 'a) (iq ((a)) ((b)) ((c)))))
          (test (iq 5 7) (iassv 5 e2))
          (test (iq 11 13) (iassoc 5 e2 <))
          (test (ipair (iq 1 1) e2) (ialist-cons 1 (ilist 1) e2))
          (test (iq (2 3) (11 13)) (ialist-delete 5 e2))
          (test (iq (2 3) (5 7)) (ialist-delete 5 e2 <))
          )

        (test-group "ilists/replacers"
          (test (ipair 1 3) (replace-icar (ipair 2 3) 1))
          (test (ipair 1 3) (replace-icdr (ipair 1 2) 3)))

        (test-group "ilists/conversion"
          (test (ipair 1 2) (pair->ipair '(1 . 2)))
          (test '(1 . 2) (ipair->pair (ipair 1 2)))
          (test (iq 1 2 3) (list->ilist '(1 2 3)))
          (test '(1 2 3) (ilist->list (iq 1 2 3)))
          (test (ipair 1 (ipair 2 3)) (list->ilist '(1 2 . 3)))
          (test '(1 2 . 3) (ilist->list (ipair 1 (ipair 2 3))))
          (test (ipair (ipair 1 2) (ipair 3 4)) (tree->itree '((1 . 2) . (3 . 4))))
          (test '((1 . 2) . (3 . 4)) (itree->tree (ipair (ipair 1 2) (ipair 3 4))))
          (test (ipair (ipair 1 2) (ipair 3 4)) (gtree->itree (cons (ipair 1 2) (ipair 3 4))))
          (test '((1 . 2) . (3 . 4)) (gtree->tree (cons (ipair 1 2) (ipair 3 4))))
          (test 6 (iapply + (iq 1 2 3)))
          (test 15 (iapply + 1 2 (iq 3 4 5))))

        ))))
